home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-12-24 | 23.7 KB | 773 lines |
- Syntax10.Scn.Fnt
- ParcElems
- Alloc
- Syntax24b.Scn.Fnt
- StampElems
- Alloc
- 24 Dec 95
- Syntax10b.Scn.Fnt
- (* AMIGA *)
- MODULE Files; (* shml/cn 16.12.1992 Oberon files mapped onto AmigaDOS files,
- NOTE
- This module is built on the assumption, that it never holds
- an exclusive lock on any of its open files. Only temporary
- files used within a single procedure (like in rename) may
- be opend exclusively, but have to be closed before the
- procedure termination.
- IMPORT
- SYSTEM,Amiga,Dos:=AmigaDos,I:=AmigaIntuition,Kernel;
- CONST
- BigEndianSet=FALSE; (* TRUE for HP,PowerOberon, FALSE for others (e.g. Amiga) *)
- BigEndianMachine=TRUE; (* 680x0 is big endian, i386 is little endian *)
- nofbufs=4;
- bufsize=4096;
- fileTabSize=100;
- noDesc=0;
- (* file states *)
- open=0; create=1; close=2;
- (* error results *)
- noError=0; directoryNotFound=1; fileNotFound=2;
- FileName=ARRAY 104 OF CHAR;
- File*=POINTER TO Handle;
- Buffer=POINTER TO BufDesc;
- FileInfoBlockPtr=POINTER TO Dos.FileInfoBlock;
- workName: The name currently in use on the underlying file system.
- registerName: Name to enter in the directory, if the file is registered.
- fl: AmigaDos lock to the file.
- fd: AmigaDos file handle to the file.
- len: legth of the file.
- pos: Remebers the actual position in the underlying AmigaDos file.
- bufs: Buffers for the file.
- swapper: Number of the last swapped out buffer.
- state: see below.
- idx:
- When a file is opened with Old, its name is stored into workName,
- registerName is empty and state becomes open. fd and fl are valid
- handle and lock to the file.
- When a file is created with New, its name is stored into registerName,
- while workName stays empty and state becomes create. fd and fl are
- not set up, as no connection to an actual file is performed at this stage.
- Create will actually associate an AmigaDos file to the Oberon file when
- this is needed. If the state is create, then only a temporary file is associated
- to it. This follows the Oberon idea, that no directory entry is made unless
- Register is called. The state close indicates to Create, that we are registering
- a file which hasn't yet an association to an AmigaDos file. The register name
- is thus used. In any case the file changes state to open, as now an association
- is made.
- Handle=RECORD
- registerName:FileName;
- fl:Dos.FileLockPtr;
- fd:Dos.FileHandlePtr;
- len,pos:LONGINT;
- bufs:ARRAY nofbufs OF Buffer;
- swapper,state,idx:INTEGER
- END;
- f: File to which this buffer belongs.
- chg: TRUE if buffer content differs from the one stored in the file.
- org: The offset within the underlying file which corresponds to the first byte of the buffer.
- size: The numer of valid bytes in this buffer.
- data: buffer space.
- BufDesc=RECORD
- f:File;
- chg:BOOLEAN;
- org,size:LONGINT;
- data:ARRAY bufsize OF SYSTEM.BYTE
- END;
- Rider*=RECORD
- res*:LONGINT;
- eof*:BOOLEAN;
- buf:Buffer;
- org,offset:LONGINT
- END;
- CurrentDir-:ARRAY 256 OF CHAR;
- searchPath:ARRAY 256 OF CHAR;
- fileTab:ARRAY fileTabSize OF LONGINT;
- startTime:LONGINT;
- tempno:INTEGER;
- PROCEDURE^ Finalize(obj:SYSTEM.PTR);
- PROCEDURE isSeekError(oldPos,pos:LONGINT):BOOLEAN;
- Pre V39 seek doesn't correctly return -1 on a seek
- error. This procedure corrects for this.
- BEGIN
- IF (oldPos=pos) & (Dos.dosVersion<39) THEN
- RETURN Dos.IoErr()#0
- ELSE
- RETURN oldPos<0
- END isSeekError;
- PROCEDURE SeekAndExtend(f:Dos.FileHandlePtr; newpos:LONGINT);
- Seek to the selected position in the file, extending it
- if necessary to reach this position.
- pos:LONGINT;
- BEGIN
- pos:=Dos.Seek(f,newpos,Dos.beginning);
- IF isSeekError(pos,newpos) THEN
- Error in seek, probably because the file was too
- short. So extend the file and then seek again.
- pos:=Dos.SetFileSize(f,newpos,Dos.beginning);
- ASSERT(pos=newpos, 44);
- pos:=Dos.Seek(f,newpos,Dos.beginning);
- ASSERT(~isSeekError(pos,newpos), 45)
- END SeekAndExtend;
- PROCEDURE MakeFileName(dir,name:ARRAY OF CHAR; VAR dest:ARRAY OF CHAR);
- BEGIN
- dest[0]:=0X;
- IF Dos.AddPart(dest,dir,LEN(dest)) THEN END;
- IF Dos.AddPart(dest,name,LEN(dest)) THEN END
- END MakeFileName;
- PROCEDURE GetTempName(VAR path:ARRAY OF CHAR);
- Generate a new temporary file name.
- n,i,c:LONGINT;
- name:FileName;
- BEGIN
- INC(tempno);
- n:=tempno;
- COPY(".tmp.00000000.00000",name);
- i:=18;
- WHILE n>0 DO
- name[i]:=CHR(n MOD 10+ORD("0"));
- n:=n DIV 10;
- DEC(i)
- END;
- n:=startTime;
- i := 12;
- WHILE n>0 DO
- c:=n MOD 16;
- IF c>9 THEN INC(c,ORD("A")-ORD("9")-1) END;
- name[i]:=CHR(c+ORD("0"));
- n:=n DIV 16;
- DEC(i)
- END;
- MakeFileName(CurrentDir,name,path)
- END GetTempName;
- PROCEDURE CacheEntry(fl:Dos.FileLockPtr):File;
- Given an AmigaDos file lock search our open file
- table, whether the file was already opened.
- f:File;
- i:INTEGER;
- BEGIN
- FOR i:=0 TO fileTabSize-1 DO
- f:=SYSTEM.VAL(File,fileTab[i]);
- IF (f#NIL) THEN
- IF Dos.SameLock(fl,f.fl)=Dos.same THEN
- RETURN f
- END
- END
- END;
- RETURN NIL
- END CacheEntry;
- PROCEDURE Rename*(old,new:ARRAY OF CHAR; VAR res:INTEGER);
- Rename a file. If necessary perform a copy/delete operation,
- to move the file across file systems.
- CONST
- bufSize=4096;
- fdold,fdnew:Dos.FileHandlePtr;
- n,errno:LONGINT;
- lock:Dos.FileLockPtr;
- buf:ARRAY bufSize OF CHAR;
- tmp:ARRAY 104 OF CHAR;
- success:BOOLEAN;
- BEGIN
- First locate the old file. Dos.Lock can only file, if the
- file doesn't exist, or if some other program than Oberon
- has it opened exclusively.
- lock:=Dos.Lock(old,Dos.sharedLock);
- IF lock=0 THEN
- res:=fileNotFound
- ELSE
- Delete any file already existing with the new name.
- IF ~Dos.DeleteFile(new) THEN res:=SHORT(Dos.IoErr()) ELSE res:=0 END;
- IF res=Dos.objectInUse THEN
- (*
- If the named file cannot be deleted, because it's
- opened, then rename it to some temporary name.
- *)
- GetTempName(tmp);
- success:=Dos.Rename(new,tmp);
- ASSERT(success,91)
- END;
- Now try to rename the old file to the
- new name.
- success:=Dos.Rename(old,new);
- Dos.UnLock(lock);
- IF ~success THEN
- errno:=Dos.IoErr();
- IF errno#Dos.renameAcrossDevices THEN
- (*
- The rename failed because of some unexpected
- reason, report this reason in res.
- *)
- res:=SHORT(errno);
- RETURN
- ELSE
- (*
- The rename failed because the new name specifies a different file
- systen than the old name. The files has to be moved by a copy
- delete operation.
- NOTE
- The new files is opened exclusively, thus should guarantee its
- closure as Oberon cannot handle exclusively locked files.
- *)
- fdold:=Dos.Open(old,Dos.oldFile);
- IF fdold=0 THEN errno:=Dos.IoErr(); HALT(92) END;
- fdnew:=Dos.Open(new,Dos.newFile);
- IF fdnew=0 THEN errno:=Dos.IoErr(); HALT(93) END;
- IF Dos.SetProtection(new,{Dos.protExecute}) THEN END; (* everything but excute *)
- n:=Dos.Read(fdold,buf,bufSize);
- WHILE n>0 DO
- errno:=Dos.Write(fdnew,buf,n);
- IF errno#n THEN
- errno:=Dos.IoErr();
- IF Dos.Close(fdold) THEN END;
- IF Dos.Close(fdnew) THEN END;
- HALT(94)
- END;
- n:=Dos.Read(fdold,buf,bufSize)
- END;
- IF Dos.Close(fdold) THEN END;
- IF Dos.Close(fdnew) THEN END;
- IF Dos.DeleteFile(old) THEN END;
- res:=0
- END
- END;
- res:=0
- END Rename;
- PROCEDURE Delete*(name:ARRAY OF CHAR; VAR res:INTEGER);
- Delete a file. If it is hold by Oberon, it is renamed to a
- temporary file.
- f:File;
- lock:Dos.FileLockPtr;
- tempName:FileName;
- BEGIN
- lock:=Dos.Lock(name,Dos.sharedLock);
- IF lock=0 THEN
- If we can't lock it, it either doesn't exist, or is
- locked exclusively by another program.
- res:=fileNotFound
- ELSE
- f:=CacheEntry(lock);
- Dos.UnLock(lock);
- IF f=NIL THEN
- (*
- The file is not one of those opened by Oberon, so just delete it
- using Dos.DeleteFile.
- *)
- IF ~Dos.DeleteFile(name) THEN res:=SHORT(Dos.IoErr()) ELSE res:=0 END
- ELSE
- (*
- The file is opened by Oberon, thus we have to rename
- it to a temporary file, and not really delete it.
- *)
- IF ~Dos.NameFromLock(f.fl,f.registerName) THEN f.registerName:="" END;
- GetTempName(tempName);
- Rename(f.registerName,tempName,res);
- IF res#0 THEN HALT(117) END
- END
- END Delete;
- PROCEDURE Create(f:File);
- err:ARRAY 25 OF CHAR;
- errno:LONGINT;
- fl:Dos.FileLockPtr;
- i,res:INTEGER;
- newName:FileName;
- oldF:File;
- tmpName:FileName;
- BEGIN
- IF f.fd=noDesc THEN
- We haven't yet associated an AmigaDos file to this
- Oberon file.
- IF f.state=create THEN
- (*
- The file was "just" created (Files.New), so assign a temporary
- name to it.
- *)
- GetTempName(newName)
- ELSIF f.state=close THEN
- (*
- We are already registering the file. Let's check, if
- try to use the name of an existing file which we already
- use. If we do, then the other file is "removed" from
- the directory, i.e. it gets a temporary name.
- *)
- fl:=Dos.Lock(f.registerName,Dos.sharedLock);
- IF fl#0 THEN
- oldF:=CacheEntry(fl);
- IF oldF#NIL THEN
- IF ~Dos.NameFromLock(oldF.fl,oldF.registerName) THEN oldF.registerName:="" END;
- GetTempName(tmpName);
- Rename(oldF.registerName,tmpName,res);
- IF res#0 THEN HALT(107) END
- END;
- Dos.UnLock(fl)
- END;
- newName:=f.registerName;
- f.registerName:=""
- END;
- IF Dos.DeleteFile(newName) THEN END;
- f.fd:=Dos.Open(newName,Dos.readWrite);
- IF f.fd=0 THEN errno:=Dos.IoErr(); err:="create not done"; HALT(95) END;
- f.fl:=0; f.idx:=-1;
- Kernel.RegisterObject(f,Finalize);
- IF Dos.SetProtection(newName,{Dos.protExecute}) THEN END; (* everything but excute *)
- i:=0;
- WHILE (i<fileTabSize) & (fileTab[i]#0) DO INC(i) END;
- IF i=fileTabSize THEN
- IF Dos.Close(f.fd) THEN END;
- f.fd:=0;
- err:="too many files open"; HALT(96)
- END;
- fileTab[i]:=SYSTEM.VAL(LONGINT,f); INC(Kernel.nofiles);
- f.state:=open; f.pos:=0; f.fl:=Dos.DupLockFromFH(f.fd); f.idx:=i
- END Create;
- PROCEDURE Flush(buf:Buffer);
- err:ARRAY 25 OF CHAR;
- errno:LONGINT;
- f:File;
- registerName,workName:FileName;
- BEGIN
- IF buf.chg THEN
- f:=buf.f;
- Create(f);
- IF buf.org#f.pos THEN SeekAndExtend(f.fd,buf.org) END;
- errno:=Dos.Write(f.fd,buf.data,buf.size);
- IF errno#buf.size THEN
- errno:=Dos.IoErr();
- IF ~Dos.NameFromLock(f.fl,workName) THEN workName:="" END;
- registerName:=f.registerName;
- err:="error in writing file";
- HALT(97)
- END;
- f.pos:=buf.org+buf.size;
- buf.chg:=FALSE
- END Flush;
- PROCEDURE Close*(f:File);
- i:INTEGER;
- BEGIN
- IF (f.state#create) OR (f.registerName#"") THEN
- Create(f);
- i:=0; WHILE (i<nofbufs) & (f.bufs[i]#NIL) DO Flush(f.bufs[i]); INC(i) END
- END Close;
- PROCEDURE Length*(f:File):LONGINT;
- BEGIN
- RETURN f.len
- END Length;
- PROCEDURE New*(name:ARRAY OF CHAR):File;
- f:File;
- BEGIN
- NEW(f); MakeFileName(CurrentDir,name,f.registerName);
- f.fd:=noDesc; f.state:=create; f.len:=0; f.pos:=0; f.swapper:=-1; (*all f.buf[i]=NIL*)
- RETURN f
- END New;
- PROCEDURE Old*(name:ARRAY OF CHAR):File;
- f:File;
- fd:Dos.FileHandlePtr;
- fl:Dos.FileLockPtr;
- err,path:ARRAY 256 OF CHAR;
- i:INTEGER;
- BEGIN
- IF name="" THEN
- f:=NIL; (* Can't open a file without a name. *)
- ELSE
- MakeFileName(CurrentDir,name,path);
- First search the file in the current directory. If it
- wasn't found, prepend the Oberon search path
- to it, and retry.
- fd:=Dos.Open(path,Dos.oldFile);
- IF (fd=0) & (name[0]#":") THEN
- MakeFileName(searchPath,name,path);
- fd:=Dos.Open(path,Dos.oldFile)
- END;
- IF fd=0 THEN
- f:=NIL; (* couldn't locate the file. *)
- ELSE
- fl:=Dos.DupLockFromFH(fd);
- f:=CacheEntry(fl);
- IF f#NIL THEN
- (*
- The file is already opened, so use the
- existing file handle, and close the
- AmigaDos file.
- *)
- Dos.UnLock(fl);
- IF Dos.Close(fd) THEN END
- ELSE
- (*
- A new file. locate a free slot in the file table,
- and enter the file.
- *)
- i:=0;
- WHILE (i<fileTabSize) & (fileTab[i]#0) DO INC(i) END;
- IF i=fileTabSize THEN
- IF Dos.Close(fd) THEN END;
- Dos.UnLock(fl);
- err:="too many files open";
- HALT(98)
- END;
- NEW(f); fileTab[i]:=SYSTEM.VAL(LONGINT,f); INC(Kernel.nofiles);
- f.len:=Dos.Seek(fd,0,Dos.end);
- f.len:=Dos.Seek(fd,f.len,Dos.beginning);
- f.fd:=fd; f.fl:= fl; f.idx:=i;
- Kernel.RegisterObject(f,Finalize);
- f.state:=open; f.pos:=0; f.swapper:=-1; (*all f.buf[i]=NIL*)
- f.registerName:=""
- END
- END
- END;
- RETURN f
- END Old;
- PROCEDURE Purge*(f:File);
- Reduce the files size to 0.
- i:INTEGER;
- BEGIN
- FOR i:=0 TO nofbufs-1 DO
- IF f.bufs[i]#NIL THEN f.bufs[i].org:=-1; f.bufs[i]:=NIL END
- END;
- IF (f.fd#noDesc) & (Dos.SetFileSize(f.fd,0,Dos.beginning)=0) THEN END;
- f.pos:=0; f.len:=0; f.swapper:=-1
- END Purge;
- PROCEDURE GetDate*(f:File; VAR t,d:LONGINT);
- Get a files date.
- fib:FileInfoBlockPtr;
- sec,min,hour,days,mday,mon,year:LONGINT;
- BEGIN
- Create(f); NEW(fib);
- IF Dos.Examine(f.fl,fib^) THEN
- sec:=fib.date.tick DIV Dos.ticksPerSecond;
- min:=fib.date.minute MOD 60;
- hour:=fib.date.minute DIV 60;
- t:=sec+ASH(min,6)+ASH(hour,12);
- days:=fib.date.days+28430; (* Days between 1.1.1978 and 1.3.1900 *)
- year:=(4*days+3) DIV 1461;
- DEC(days,1461*year DIV 4);
- mon:=(5*days+2) DIV 153;
- mday:=days-(153*days+2) DIV 5 +1;
- INC(mon,3);
- IF mon>12 THEN INC(year); DEC(mon,12) END;
- d:=mday+ASH(mon,5)+ASH(year MOD 100,9)
- ELSE
- t:=0; d:=0
- END GetDate;
- PROCEDURE Pos*(VAR r:Rider):LONGINT;
- Get the position of a rider.
- BEGIN
- RETURN r.org+r.offset
- END Pos;
- PROCEDURE Set*(VAR r:Rider; f:File; pos:LONGINT);
- Set the rider to a specific position within the file.
- buf:Buffer;
- err:ARRAY 25 OF CHAR;
- org,offset,i,n,errno:LONGINT;
- workName,registerName:FileName;
- BEGIN
- IF pos>f.len THEN pos:=f.len ELSIF pos<0 THEN pos:=0 END;
- offset:=pos MOD bufsize; org:=pos-offset; i:=0;
- WHILE (i<nofbufs) & (f.bufs[i]#NIL) & (org#f.bufs[i].org) DO INC(i) END;
- IF i<nofbufs THEN
- IF f.bufs[i]=NIL THEN NEW(buf); buf.chg:=FALSE; buf.org:=-1; buf.f:=f; f.bufs[i]:=buf; (* found empty buffer slot. *)
- ELSE buf:=f.bufs[i]; (* found buffer which contains position. *)
- END
- ELSE
- All slots used, but none containing the requested position.
- Swap out one of the buffers.
- f.swapper:=(f.swapper+1) MOD nofbufs;
- buf:=f.bufs[f.swapper];
- Flush(buf)
- END;
- IF buf.org#org THEN
- A new buffer was selected. If the selected position is at the
- end of the file, just an empty buffer is initialized. Otherwise,
- the buffer is loaded from the file.
- IF org=f.len THEN
- buf.size:=0
- ELSE
- Create(f);
- IF f.pos#org THEN n:=Dos.Seek(f.fd,org,Dos.beginning) END;
- n:=Dos.Read(f.fd,buf.data,bufsize);
- IF n<0 THEN errno:=Dos.IoErr();
- IF ~Dos.NameFromLock(f.fl,workName) THEN workName:="" END;
- registerName:=f.registerName;
- err:="read not done"; HALT(99)
- END;
- f.pos:=org+n;
- buf.size:=n
- END;
- buf.org:=org; buf.chg:=FALSE
- END;
- r.buf:=buf; r.org:=org; r.offset:=offset; r.eof:=FALSE; r.res:=0
- END Set;
- PROCEDURE Read*(VAR r:Rider; VAR x:SYSTEM.BYTE);
- buf:Buffer;
- offset:LONGINT;
- BEGIN
- buf:=r.buf; offset:=r.offset;
- IF r.org#buf.org THEN Set(r,buf.f,r.org+offset); buf:=r.buf; offset:=r.offset END;
- IF (offset<buf.size) THEN
- x:=buf.data[offset]; r.offset:=offset+1
- ELSIF r.org+offset<buf.f.len THEN
- Set(r,r.buf.f,r.org+offset);
- x:=r.buf.data[0]; r.offset:=1
- ELSE
- x:=0X; r.eof:=TRUE
- END Read;
- PROCEDURE ReadBytes*(VAR r:Rider; VAR x:ARRAY OF SYSTEM.BYTE; n:LONGINT);
- buf:Buffer;
- xpos,min,restInBuf,offset:LONGINT;
- BEGIN
- IF n>LEN(x) THEN HALT(43) END;
- xpos:=0; buf:=r.buf; offset:=r.offset;
- WHILE n>0 DO
- IF (r.org#buf.org) OR (offset>=bufsize) THEN
- Set(r,buf.f,r.org+offset);
- buf:=r.buf; offset:=r.offset
- END;
- restInBuf:=buf.size-offset;
- IF restInBuf=0 THEN r.res:=n; r.eof:=TRUE; RETURN
- ELSIF n>restInBuf THEN min:=restInBuf
- ELSE min:=n
- END;
- SYSTEM.MOVE(SYSTEM.ADR(buf.data)+offset,SYSTEM.ADR(x)+xpos,min);
- INC(offset,min); r.offset:=offset; INC(xpos,min); DEC(n,min)
- END;
- r.res:=0; r.eof:=FALSE
- END ReadBytes;
- PROCEDURE Base*(VAR r:Rider):File;
- Get the file on which this rider is based.
- BEGIN
- RETURN r.buf.f
- END Base;
- PROCEDURE Write*(VAR r:Rider; x:SYSTEM.BYTE);
- buf:Buffer;
- offset:LONGINT;
- BEGIN
- buf:=r.buf; offset:=r.offset;
- IF (r.org#buf.org) OR (offset>=bufsize) THEN
- Set(r,buf.f,r.org+offset);
- buf:=r.buf; offset:=r.offset
- END;
- buf.data[offset]:=x;
- buf.chg:=TRUE;
- IF offset=buf.size THEN
- INC(buf.size); INC(buf.f.len)
- END;
- r.offset:=offset+1; r.res:=0
- END Write;
- PROCEDURE WriteBytes*(VAR r:Rider; VAR x:ARRAY OF SYSTEM.BYTE; n:LONGINT);
- xpos,min,restInBuf,offset:LONGINT;
- buf:Buffer;
- BEGIN
- IF n>LEN(x) THEN HALT(43) END;
- xpos:=0; buf:=r.buf; offset:=r.offset;
- WHILE n>0 DO
- IF (r.org#buf.org) OR (offset>=bufsize) THEN
- Set(r,buf.f,r.org+offset);
- buf:=r.buf; offset:=r.offset
- END;
- restInBuf:=bufsize-offset;
- IF n>restInBuf THEN min:=restInBuf ELSE min:=n END;
- SYSTEM.MOVE(SYSTEM.ADR(x)+xpos,SYSTEM.ADR(buf.data)+offset,min);
- INC(offset,min); r.offset:=offset;
- IF offset>buf.size THEN INC(buf.f.len,offset-buf.size); buf.size:=offset END;
- INC(xpos,min); DEC(n,min); buf.chg:=TRUE
- END;
- r.res:=0
- END WriteBytes;
- PROCEDURE Register*(f:File);
- errno:INTEGER;
- file:FileName;
- BEGIN
- IF (f.state=create) & (f.registerName#"") THEN f.state:=close (* shortcut renaming *) END;
- Close(f);
- IF f.registerName#"" THEN
- IF ~Dos.NameFromLock(f.fl,file) THEN file:="" END;
- Rename(file,f.registerName,errno);
- IF errno#0 THEN COPY(f.registerName,file); HALT(100) END;
- f.registerName:=""
- END Register;
- PROCEDURE ChangeDirectory*(path:ARRAY OF CHAR; VAR res:INTEGER);
- lock,oldLock:Dos.FileLockPtr;
- BEGIN
- lock:=Dos.Lock(path,Dos.sharedLock);
- IF lock#0 THEN
- oldLock:=Dos.CurrentDir(lock);
- Dos.UnLock(oldLock);
- IF Dos.NameFromLock(lock,CurrentDir) THEN END;
- res:=noError
- ELSE
- res:=directoryNotFound
- END ChangeDirectory;
- (*----------------- Files1 ----------------*)
- little endian,
- ORD({0})=1,
- false=0,true =1
- IEEE real format,
- null terminated strings,
- compact format according to M.Odersky
- PROCEDURE FlipBytes(VAR src,dest:ARRAY OF SYSTEM.BYTE);
- i,j:LONGINT;
- BEGIN
- j:=0;
- FOR i:=LEN(src)-1 TO 0 BY -1 DO dest[j]:=src[i]; INC(j) END
- END FlipBytes;
- PROCEDURE ReadBool*(VAR R:Rider; VAR x:BOOLEAN);
- BEGIN
- Read(R,SYSTEM.VAL(CHAR,x))
- END ReadBool;
- PROCEDURE ReadInt*(VAR R:Rider; VAR x:INTEGER);
- b:ARRAY 2 OF CHAR;
- BEGIN
- ReadBytes(R,b,2);
- x:=ORD(b[0])+ORD(b[1])*256
- END ReadInt;
- PROCEDURE ReadLInt*(VAR R:Rider; VAR x:LONGINT);
- b:ARRAY 4 OF CHAR;
- BEGIN
- ReadBytes(R,b,4);
- x:=LONG(ORD(b[0]))+LONG(ORD(b[1]))*100H+LONG(ORD(b[2]))*10000H+LONG(ORD(b[3]))*1000000H
- END ReadLInt;
- PROCEDURE ReadSet*(VAR R:Rider; VAR x:SET);
- b:ARRAY 4 OF CHAR;
- s2,s3:SET;
- i:LONGINT;
- BEGIN
- IF BigEndianSet THEN
- ReadBytes(R,b,4);
- s2:=SYSTEM.VAL(SET,LONG(ORD(b[0]))+LONG(ORD(b[1]))*100H +
- LONG(ORD(b[2]))*10000H +LONG(ORD(b[3]))*1000000H);
- s3:={};
- FOR i:=0 TO 31 DO
- IF i IN s2 THEN INCL(s3,31-i) END
- END;
- x:=s3
- ELSE
- IF BigEndianMachine THEN ReadBytes(R,b,4); FlipBytes(b,x)
- ELSE ReadBytes(R,x,4)
- END
- END ReadSet;
- PROCEDURE ReadReal*(VAR R:Rider; VAR x:REAL);
- b:ARRAY 4 OF CHAR;
- BEGIN
- IF BigEndianMachine THEN ReadBytes(R,b,4); FlipBytes(b,x)
- ELSE ReadBytes(R,x,4)
- END ReadReal;
- PROCEDURE ReadLReal*(VAR R:Rider; VAR x:LONGREAL);
- b:ARRAY 8 OF CHAR;
- BEGIN
- IF BigEndianMachine THEN ReadBytes(R,b,8); FlipBytes(b,x)
- ELSE ReadBytes(R,x,8)
- END ReadLReal;
- PROCEDURE ReadString*(VAR R:Rider; VAR x:ARRAY OF CHAR);
- i:INTEGER;
- ch:CHAR;
- BEGIN
- i:=0; REPEAT Read(R,ch); x[i]:=ch; INC(i) UNTIL ch=0X
- END ReadString;
- PROCEDURE ReadNum*(VAR R:Rider; VAR x:LONGINT);
- ch:CHAR;
- n:LONGINT;
- s:SHORTINT;
- BEGIN
- s:=0; n:=0; Read(R,ch);
- WHILE ORD(ch)>=128 DO INC(n,ASH(LONG(ORD(ch))-128,s) ); INC(s,7); Read(R,ch) END;
- x:=n+ASH(LONG(ORD(ch)) MOD 64-ORD(ch) DIV 64*64,s)
- END ReadNum;
- PROCEDURE WriteBool*(VAR R:Rider; x:BOOLEAN);
- BEGIN
- Write(R,SYSTEM.VAL(CHAR,x))
- END WriteBool;
- PROCEDURE WriteInt*(VAR R:Rider; x:INTEGER);
- b:ARRAY 2 OF CHAR;
- BEGIN
- b[0]:=CHR(x); b[1]:=CHR(x DIV 256);
- WriteBytes(R,b,2)
- END WriteInt;
- PROCEDURE WriteLInt*(VAR R:Rider; x:LONGINT);
- b:ARRAY 4 OF CHAR;
- BEGIN
- b[0]:=CHR(x); b[1]:=CHR(x DIV 100H); b[2]:=CHR(x DIV 10000H); b[3]:=CHR(x DIV 1000000H);
- WriteBytes(R,b,4)
- END WriteLInt;
- PROCEDURE WriteSet*(VAR R:Rider; x:SET);
- b:ARRAY 4 OF CHAR; i:LONGINT; s2:SET;
- BEGIN
- IF BigEndianSet THEN
- s2:={};
- FOR i:=0 TO 31 DO
- IF i IN x THEN INCL(s2,31-i) END
- END;
- i:=SYSTEM.VAL(LONGINT,s2);
- b[0]:=CHR(i); b[1]:=CHR(i DIV 100H); b[2]:=CHR(i DIV 10000H); b[3]:=CHR(i DIV 1000000H);
- WriteBytes(R,b,4)
- ELSE
- IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,4)
- ELSE WriteBytes(R,x,4)
- END
- END WriteSet;
- PROCEDURE WriteReal*(VAR R:Rider; x:REAL);
- b:ARRAY 4 OF CHAR;
- BEGIN
- IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,4)
- ELSE WriteBytes(R,x,4)
- END WriteReal;
- PROCEDURE WriteLReal*(VAR R:Rider; x:LONGREAL);
- b:ARRAY 8 OF CHAR;
- BEGIN
- IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,8)
- ELSE
- WriteBytes(R,x,8)
- END WriteLReal;
- PROCEDURE WriteString*(VAR R:Rider; x:ARRAY OF CHAR);
- i:INTEGER;
- BEGIN
- i:=0; WHILE x[i]#0X DO INC(i) END;
- WriteBytes(R,x,i+1)
- END WriteString;
- PROCEDURE WriteNum*(VAR R:Rider; x:LONGINT);
- BEGIN
- WHILE (x<-64) OR (x>63) DO Write(R,CHR(x MOD 128+128)); x:=x DIV 128 END;
- Write(R,CHR(x MOD 128))
- END WriteNum;
- PROCEDURE Finalize(obj:SYSTEM.PTR);
- file:File;
- pref:FileName;
- name:FileName;
- BEGIN
- file:=SYSTEM.VAL(File,obj);
- ASSERT(file#NIL);
- IF ~Dos.NameFromLock(file.fl,name) THEN name:="" END;
- IF file.fl#0 THEN
- Dos.UnLock(file.fl);
- file.fl:=0
- END;
- IF file.fd#noDesc THEN
- SeekAndExtend(file.fd,file.len);
- IF Dos.Close(file.fd) THEN END;
- file.fd:=noDesc
- END;
- IF file.idx>=0 THEN
- DEC(Kernel.nofiles);
- fileTab[file.idx]:=0
- END;
- test for ".tmp." in first 5 chars and call Dos.Deletefile in
- this case.
- Dos.FilePart(name,pref);
- pref[5]:=0X;
- IF pref=".tmp." THEN
- IF ~Dos.DeleteFile(name) THEN
- END
- END Finalize;
- PROCEDURE Init;
- i:LONGINT;
- lock:Dos.FileLockPtr;
- BEGIN
- I.CurrentTime(startTime,i);
- tempno:=-1;
- lock:=Dos.Lock("",Dos.sharedLock);
- IF ~Dos.NameFromLock(lock,CurrentDir) THEN CurrentDir:="" END;
- Dos.UnLock(lock);
- FOR i:=0 TO fileTabSize-1 DO fileTab[i]:=0 END;
- Kernel.nofiles:=0;
- Amiga.GetSearchPath(searchPath)
- END Init;
- BEGIN
- Init
- END Files.
-